home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™ 1987-1994 / MacHack™ '91 / Hacks '91 / Fuzzy Balls / Fuzzy Balls FKEY.p < prev    next >
Encoding:
Text File  |  1991-06-20  |  9.3 KB  |  289 lines  |  [TEXT/PJMM]
  1. {    Fuzzy Balls FKEY © 1991 by Jon Wind                                                                }
  2. {    Version 1.0 on 6/20/91                                                                                }
  3. {}
  4. {    This FKEY is a poor man’s screen saver. It displays shaded balls in color, grays, or b&w,    }
  5. {    depending on the monitor.  Approximately 60 circles are drawn per second.  Random ball        }
  6. {    sizes are used unless the caps lock key is down.  Every 15 seconds the screen the screen    }
  7. {    is cleared to black and a new ball size is randomly chosen (25-80 pixels).  If the control        }
  8. {    key is down when the FKEY is called, ball shading is reversed.  It should work correctly on    }
  9. {    any Mac, even on Macs that have b&w and color monitors.                                        }
  10. {}
  11. {     Thanks to Brad Pettit and his colorfkey for his method of conditional compilation.                }
  12. {}
  13. {    To execute this as a program...                                                                        }
  14. {        1. change the definition of fkey to false                                                        }
  15. {        2. set the project type to application                                                            }
  16. {        3. change the library from drvrruntime.lib to µruntime.lib                                    }
  17. {        4. rebuild the project                                                                            }
  18.  
  19.  
  20. {$setc fkey := true}
  21.  
  22. {$ifc fkey}
  23.  
  24. unit BallsFKEY;
  25.  
  26. interface
  27.  
  28.     uses
  29.         Picker;
  30.  
  31.     procedure main;
  32.  
  33. implementation
  34.  
  35. {$elsec}
  36.  
  37.     program BallsFKEY;
  38.  
  39.  
  40.         uses
  41.             Picker;
  42.  
  43. {$endc}
  44.  
  45.         procedure main;
  46.             const
  47.                 bCommandKey = 48;
  48.                 bShiftKey = 63;
  49.                 bControlKey = 60;
  50.                 bOptionKey = 61;
  51.                 bCapsLockKey = 62;
  52.                 RawMouseGlobal = $82C;
  53.                 WNETrapNum = $60;            { trap number of WaitNextEvent }
  54.                 UnImplTrapNum = $9F;        { trap number of "unimplemented trap" }
  55.                 CreditTime = 180;
  56.                 WaitTime = 75;                        { number of ticks to wait before starting drawing balls }
  57.                 ClsTime = 900;                        { clear screen interval in ticks }
  58.                 minBall = 25;
  59.                 maxBall = 80;
  60.                 firstPat = 1;
  61.                 lastPat = 8;
  62.                 Line1 = 'Written by Jon Wind on 6/20/91.';
  63.                 Line2 = 'Press Caps Lock for static sizes.';
  64.                 Line3 = 'Launch with Control key to reverse shading.';
  65.  
  66.             var
  67.                 ballwidth, i, x, patAdjust: Integer;
  68.                 iconRect, scrnRect: Rect;
  69.                 savePort: GrafPtr;
  70.                 oldmouseLoc, oldTicks, lastCls, L: LongInt;
  71.                 Credits, hasColor, multiBit, useColor, wakeup, WNE: Boolean;
  72.                 theEvent: EventRecord;
  73.                 w: WindowPtr;
  74.                 region: RgnHandle;
  75.                 patArray: array[firstPat..lastPat] of pattern;
  76.                 deviceHdl: GDHandle;
  77.                 theHSV: HSVColor;
  78.                 theRGB: RGBColor;
  79.  
  80.  
  81.             function GetLRandom (min, max: Longint): Longint;
  82.     { return a random number within a given range }
  83.                 var
  84.                     y: Longint;
  85.             begin
  86.                 y := min;
  87.                 if min < max then
  88.                     repeat
  89.                         y := random;
  90.                         y := (((y + maxint) * max) div 16383) + min;
  91.                     until (y >= min) & (y <= max);
  92.                 GetLRandom := y;
  93.             end; { of func GetLRandom }
  94.  
  95.             function GetKeyDown (index: Integer): Boolean;
  96.     { return the stae of the desired key - true if down; false if up }
  97.                 var
  98.                     keys: keymap;
  99.             begin
  100.                 GetKeys(keys);
  101.                 GetKeyDown := bittst(@keys, index);        { look at entry within the key map }
  102.             end;
  103.  
  104.             procedure Check4Color (var hasColor, multiBit: Boolean);
  105.     { hasColor = true if using 4 or more "colors", multiBit = true if colorDevices <> totalDevices }
  106.                 var
  107.                     deviceHdl: GDHandle;
  108.                     theWorld: SysEnvRec;
  109.                     totalDevices, colorDevices: Integer;
  110.             begin
  111.                 colorDevices := 0;                { assume no color devices }
  112.                 totalDevices := 0;                { assume no devices }
  113.                 if (SysEnvirons(1, theWorld) <> envNotPresent) then    { SysEnvirons call is available }
  114.                     if theWorld.hasColorQD then        { has Color QuickDraw }
  115.                         begin
  116.                             deviceHdl := GetDeviceList;
  117.                             repeat
  118.                                 if deviceHdl <> nil then
  119.                                     begin
  120.                                         totalDevices := Succ(totalDevices);
  121.                                         if (deviceHdl^^.gdPMap^^.pixelsize > 1) then    { 4 or more shades? }
  122.                                             colorDevices := Succ(colorDevices);
  123.                                     end;
  124.                                 deviceHdl := GetNextDevice(deviceHdl);
  125.                             until deviceHdl = nil;
  126.                         end;
  127.                 multiBit := (colorDevices <> totalDevices);
  128.                 hasColor := (colorDevices > 0);
  129.             end;{ of proc Check4Color }
  130.  
  131.             function myGetGrayRgn: Handle;
  132.     { get current gray region }
  133.                 var
  134.                     thePtr: ^Handle;
  135.             begin
  136.                 thePtr := Pointer($9EE);
  137.                 myGetGrayRgn := thePtr^;
  138.             end;  { of func GetGrayRgn }
  139.  
  140.             function GetRawMouse: LongInt;
  141.     { get current mouse location }
  142.                 var
  143.                     thePtr: ^LongInt;
  144.             begin
  145.                 thePtr := Pointer(RawMouseGlobal);
  146.                 GetRawMouse := thePtr^;
  147.             end;  { of func GetRawMouse }
  148.  
  149.  
  150.  { --------- Main Procedure --------- }
  151.         begin
  152.             GetPort(savePort);                    { save current grafport }
  153.  
  154.             WNE := NGetTrapAddress(WNETrapNum, ToolTrap) <> NGetTrapAddress(UnImplTrapNum, ToolTrap);
  155.  
  156.             theHSV.value := 50000;                { use darker colors }
  157.             theHSV.saturation := -1;
  158.  
  159.     { create "magic" shading patterns }
  160.             StuffHex(@patArray[1], '77FFDDFF57FFDDFF');
  161.             StuffHex(@patArray[2], '55FFDDFF55FF5DFF');
  162.             StuffHex(@patArray[3], '55BF55FF55FB55FF');
  163.             StuffHex(@patArray[4], '55EE55BB55EE55BA');
  164.             StuffHex(@patArray[5], '5599556A559955A6');
  165.             StuffHex(@patArray[6], '5598552255895522');
  166.             StuffHex(@patArray[7], 'AA40AA00AA04AA00');
  167.             StuffHex(@patArray[8], '0045001100540011');
  168.  
  169.             oldmouseLoc := GetRawMouse;
  170.             Check4Color(hasColor, multiBit);        { determine whether there's one or more color monitors running in color }
  171.             if GetKeyDown(bControlKey) then
  172.                 patAdjust := 9
  173.             else
  174.                 patAdjust := 0;
  175.  
  176.             region := NewRgn;
  177.             CopyRgn(RgnHandle(myGetGrayRgn), region);        { get total screen area including menu bar }
  178.             scrnRect := region^^.rgnBBox;
  179.             if (scrnRect.top > 0) then
  180.                 scrnRect.top := 0;
  181.  
  182.             if hascolor then
  183.                 w := NewCWindow(nil, scrnRect, '', True, altDBoxProc, Pointer(-1), False, 0)
  184.             else
  185.                 w := NewWindow(nil, scrnRect, '', True, altDBoxProc, Pointer(-1), False, 0);
  186.  
  187.             RectRgn(region, w^.portRect);
  188.             UnionRgn(region, w^.visRgn, w^.visRgn);    { I want to cover everything, including the menu bar }
  189.             DisposeRgn(region);            { don't need it any more… }
  190.  
  191.             SetPort(w);                        { set as current port }
  192.             ClipRect(scrnRect);
  193.             PaintRect(scrnRect);
  194.             LastCls := TickCount;            { set to current "time" }
  195.  
  196.             ObscureCursor;
  197.  
  198.             Credits := True;                { I'm going to show a brief credits message… }
  199.             TextMode(srcBic);                { white credits text on black background… }
  200.             MoveTo(40, 50);
  201.             DrawString(Line1);
  202.             MoveTo(40, 70);
  203.             DrawString(Line2);
  204.             MoveTo(40, 90);
  205.             DrawString(Line3);
  206.  
  207.             Delay(WaitTime, L);            { delay to allow keys to be released and message to be read }
  208.  
  209.             repeat
  210.                 oldTicks := TickCount;        { store current "time" }
  211.  
  212.                 if not Credits then
  213.                     begin
  214.                         if (TickCount - LastCls > ClsTime) then
  215.                             begin
  216.                                 ballwidth := GetLRandom(minBall, maxBall);    { generate new ball width with each screen clear }
  217.                                 PenNormal;
  218.                                 PaintRect(scrnRect);
  219.                                 lastCls := TickCount;                                { get time of last screen clear }
  220.                             end;
  221.  
  222.                         if not GetKeyDown(bCapsLockKey) then
  223.                             ballwidth := GetLRandom(minBall, maxBall);        { generate new ball width if caps lock is up - not down! }
  224.  
  225.                         iconRect.top := GetLRandom(scrnRect.top - BSR(ballwidth, 1), scrnRect.bottom);    { guarantee clipping on screen top }
  226.                         iconRect.left := GetLRandom(scrnRect.left - BSR(ballwidth, 1), scrnRect.right);    { guarantee clipping on screen left }
  227.                         iconRect.right := iconRect.left + ballwidth;            { make rectangle a square }
  228.                         iconRect.bottom := iconRect.top + ballwidth;            { make rectangle a square }
  229.  
  230.                         usecolor := hasColor;
  231.                         if hasColor & multiBit then        { must check depth of screen - may be B&W }
  232.                             begin
  233.                                 LocalToGlobal(iconRect.topLeft);
  234.                                 LocalToGlobal(iconRect.botRight);
  235.                                 deviceHdl := GetMaxDevice(iconRect);        { get deepest device covered by rect }
  236.                                 useColor := (deviceHdl <> nil) & (deviceHdl^^.gdPMap^^.pixelsize > 2);
  237.                             end;
  238.                         if useColor then            { generate random rgb color }
  239.                             begin
  240.                                 theHSV.hue := GetLRandom(0, 65535);
  241.                                 HSV2RGB(theHSV, theRGB);
  242.                                 RGBBackColor(theRGB);
  243.                             end;
  244.  
  245.          { use patterns to draw shaded balls }
  246.                         x := BSR(ballwidth div Succ(lastPat), 1);
  247.                         for i := firstPat to lastPat do
  248.                             begin
  249.                                 PenPat(patArray[Abs(patAdjust - i)]);
  250.                                 PaintOval(iconRect);
  251.                                 InsetRect(iconRect, x, x);
  252.                                 iconRect.bottom := iconRect.bottom - x;
  253.                                 iconRect.right := iconRect.right - x;
  254.                             end;
  255.  
  256.                     end
  257.                 else if (TickCount - LastCls > CreditTime) then    { past time when credits should be displayed - only executes once }
  258.                     begin
  259.                         Credits := False;            { indicate credits no longer need to be displayed }
  260.                         LastCls := 0;                { set to 0 to force a screen clear, set ball width, etc. }
  261.                     end;
  262.  
  263.                 repeat
  264.                     if WNE then
  265.                         wakeup := WaitNextEvent(mDownMask + keyDownMask + diskMask, theEvent, 1, nil)    { an event... }
  266.                     else
  267.                         wakeup := GetNextEvent(mDownMask + keyDownMask + diskMask, theEvent);        { if there's an event... }
  268.                     if wakeup then            { make sure it's an event we want... }
  269.                         wakeup := (theEvent.what = mouseDown) or (theEvent.what = keyDown) or (theEvent.what = diskEvt);
  270.                 until wakeup or (TickCount > oldTicks);            { effectively limits drawing speed to approx. one ball per tick }
  271.             until wakeup or (oldmouseLoc <> GetRawMouse) or GetKeyDown(bOptionKey) or GetKeyDown(bCommandKey) or GetKeyDown(bShiftKey) or GetKeyDown(bControlKey);
  272.  
  273.             PenNormal;
  274.             PaintRect(scrnRect);
  275.             DisposeWindow(w);            { don't need it any more… }
  276.             SetPort(savePort);            { restore previous grafport }
  277.             InitCursor;                        { restore cursor - and probably piss off the current app if it wasn't using the arrow… }
  278.             DrawMenuBar;                    { fix menubar }
  279.         end;    { main }
  280.  
  281.  
  282. {$ifc fkey = false}
  283.  
  284.     begin
  285.         main;
  286.  
  287. {$endc}
  288.  
  289.     end.